home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -screenplay- / shareware / solitarexx / scripts / klondike.srx < prev    next >
Text File  |  2000-02-29  |  3KB  |  143 lines
  1. /********************************\
  2. ** Klondike v1.0 for Solitarexx **
  3. **     by Michal Szafranski     **
  4. \********************************/
  5. OPTIONS RESULTS
  6.  
  7. tex = '"Klondike v1.0"'
  8. wintex = '"We Have a Winner"'
  9. ADDBUTTON 0 10 "Start"
  10. ADDTEXT 4 42 tex 6
  11. ADDCYCLE 7 9 'No|Yes' 0 '"Move parts"' 14
  12. ADDCYCLE 9 12 '"Inf.|Once|Twice|3 Times|4 Times|5 Times|6 Times"' 1 '"Rotate deck"' 16
  13. ADDCYCLE 11 12 '"3-2-1|One|Two|Three"' 1 '"Cards at once"' 17
  14. ADDBUTTON 12 10 "Abort"
  15. ADDTEXT 14 42 tex 6
  16. SELECTGUI 3
  17.  
  18. SCREENSIZE 2 15 7 0
  19. DO i = 0 TO 6
  20.     NEWSTACK 3 16+4 0 i 0 0 0 15
  21.     stack.i = RESULT
  22. END
  23. DO i = 0 TO 3
  24.     NEWSTACK 4 0 i+2 i+3 1 0 15
  25.     base.i = RESULT
  26. END
  27. NEWSTACK 1 0 1 0 1 0 15
  28. deck = RESULT
  29. NEWSTACK 2 32+8+1 1 1 1 0 15 2 2
  30. waste = RESULT
  31. ADDCARDS deck SHUFFLED
  32.  
  33. DO FOREVER
  34.     ACTION
  35.     PARSE VAR RESULT act rest
  36.     IF act = 1 THEN EXIT
  37.     IF act = 3 THEN CALL GAME
  38. END
  39.  
  40. GAME:
  41.     CLEANUP deck
  42.     SETGADGET 14 STR tex
  43.     SELECTGUI 4
  44.     sel = 0
  45.     time = 0
  46.     fin = 0
  47.     GETGADGET 9
  48.     gadtimes = RESULT
  49.     GETGADGET 11
  50.     gadcards = RESULT
  51.     GETGADGET 7
  52.     moveparts = RESULT
  53.     ile. = 0
  54.     SELECT
  55.         WHEN gadcards = 0 THEN DO
  56.             ile.0 = 3
  57.             ile.1 = 2
  58.             ile.2 = 1
  59.         END
  60.         WHEN gadtimes = 0 THEN ile. = gadcards
  61.         OTHERWISE DO i = 0 TO gadtimes-1
  62.             ile.i = gadcards
  63.         END
  64.     END
  65.     DO i=0 TO 6
  66.         CARDSELECT deck i
  67.         MOVECARDS deck stack.i
  68.         CARDSELECT deck 1
  69.         MOVECARDS deck stack.i REVERSE
  70.     END
  71.     DO FOREVER
  72.         ACTION
  73.         PARSE VAR RESULT act stack sid card
  74.         IF act = 1 THEN EXIT
  75.         IF act = 2 THEN SELECT
  76.             WHEN sid=1 THEN CALL DODECK
  77.             WHEN sel=0 & card>0 & sid~=4 THEN sel = stack
  78.             WHEN sel>0 & (sel = stack | sid = 4) THEN CALL DOBASE
  79.             WHEN sel>0 & sid = 3 THEN CALL DOSTACKS
  80.             OTHERWISE ERRBEEP
  81.         END
  82.         IF act = 3 THEN DO
  83.             SELECTGUI 3
  84.             RETURN
  85.         END
  86.     END
  87. RETURN
  88. DODECK:
  89.     IF sel=waste THEN sel=0
  90.     CARDSELECT deck ile.time
  91.     IF RESULT = '' THEN DO
  92.         CARDSELECT waste 52
  93.         MOVECARDS waste deck REVERSE
  94.         time = time+1
  95.     END
  96.     ELSE MOVECARDS deck waste REVERSE
  97. RETURN
  98. DOSTACKS:
  99.     CARDSELECT sel 0 RELATIVE
  100.     PARSE VAR RESULT kolors wars xx
  101.     IF moveparts = 0 THEN DO
  102.         WHICHCARD sel VISIBLE
  103.         PARSE VAR RESULT len lsel
  104.         IF lsel ~= 1 & lsel ~= len THEN RETURN
  105.     END
  106.     CARDSELECT stack 1
  107.     PARSE VAR RESULT kolor war xx
  108.     IF kolor = '' THEN DO
  109.         war = 13
  110.         kolor = kolors+1
  111.     END
  112.     kolor = (kolor+kolors) // 2
  113.     IF war = wars+1 & kolor = 1 THEN MOVECARDS sel stack ATONCE
  114.     ELSE ERRBEEP
  115.     sel = 0
  116. RETURN
  117. DOBASE:
  118.     IF sel~=stack THEN CALL CHBASE
  119.     ELSE DO i= 0 TO 3 UNTIL ok=0
  120.         stack = base.i
  121.         CALL CHBASE
  122.     END
  123.     IF ok=0 THEN DO
  124.         fin = fin +1
  125.         MOVECARDS sel stack
  126.         IF fin = 52 THEN SETGADGET 14 STR wintex
  127.     END
  128.     ELSE ERRBEEP
  129.     sel = 0
  130. RETURN
  131. CHBASE:
  132.     CARDSELECT sel 1
  133.     PARSE VAR RESULT kolors wars xx
  134.     CARDSELECT stack 1
  135.     PARSE VAR RESULT kolor war xx
  136.     IF kolor = '' THEN DO
  137.         kolor = kolors
  138.         war = -1
  139.     END
  140.     IF kolor = kolors & (wars - war) = 1 THEN ok = 0
  141.     ELSE ok = 1
  142. RETURN
  143.